home *** CD-ROM | disk | FTP | other *** search
/ Die Speccy' 97 / Die Speccy' 97.iso / amiga_system / the_aminet / comm / cnet / cnet_who.lha / Who / Long < prev    next >
Text File  |  1995-10-15  |  14KB  |  141 lines
  1. /**************************************************************************\
  2.             $VER: CNet Long WHO, v2.51 (15-Oct-95) by Dotoran!
  3. \**************************************************************************/
  4. options results;signal on SYNTAX;signal on ERROR;signal on IOERR
  5. tr=transmit;se=sendstring;gu=getuser;gs=getscratch;gc=getchar;mg=maygetchar
  6. a='rexxsupport.library';if ~show('l',a) then if ~addlib(a,0,-30) then exit
  7. changewhere 'Long WHO';gu 39;uucp=result;mdir="mail:users/"uucp"/"
  8. glimpse=mdir"_Glimpse";glimpse2="pfiles:who/_Glimpse"
  9. banners=mdir"_Banners";banners2="pfiles:who/_Banners"
  10. history=mdir"_History";history2="pfiles:who/_History"
  11. low=0;gu 2225094;high=result;gu 23;myport=result;gu 1100660;a=result;mci1=BitTST(d2c(a,4),0);mci2=BitTST(d2c(a,4),1)
  12. pd=2424286;gu 55;help=result;gu 2107337;idle=result;gu 1100663;sysop=BitTST(d2c(result,4),4)
  13. gu 1100661;conf=BitTST(d2c(result,4),7);call CONFIG;quick=0;gu 1302307;arg=upper(result);args=low'-'high
  14. if arg>''&index('CIEQ?BGVHP',left(arg,1))=0 then call ARGS;arg=left(arg,1);tot=high;call PARSER(args,0,high);if totpit=0 then arg='?'
  15. helpT='n1cfLong Whoc6, vcb2c6.cb50 c6by cdDotorann2Cc7Formatsce: '
  16. if conf=1 then do;helpT=helpT'caWHO c7[c6<ceCc6>ceonfigc7]       c6--- c9Conference Controllers cfONLYc9!n1'
  17. helpT=helpT'CcaWHO c7[c6<ceIc6>cedle Loaderc7]  c6--- c9Conference Controllers cfONLYc9!n1'
  18. helpT=helpT'CcaWHO c7[c6<ceEc6>cedit Idlesc7]   c6--- c9Conference Controllers cfONLYc9!n1';end
  19. helpT=helpT'CcaWHO c7[c6<ceQc6>ceuick Listc7]n1CcaWHO c7[c6<cePc6>ceort Bannerc7]n1'
  20. helpT=helpT'CcaWHO c7[c6<ceBc6>ceannersc7]n1CcaWHO c7[c6<ceGc6>celimpsec7]n1'
  21. helpT=helpT'CcaWHO c7[c6<ceVc6>ceiew c6<caHc6>caistoryc7]n1'
  22. helpT=helpT'CcaWHO c7[c6portce# c6pce#cb-c6pce# c6pce#cb,c6pce# cb-c6pce# c6pce#cb-c7] cbetcc6...'
  23.  
  24. v1=1;v2=1;v3=1;v4=0;v5=0;v6=0;loS=0;hiSk=0;v7=1;v8=1;v9=0;if v7=1&index('CIE?BGVHP',arg)=0 then tr 'f1'
  25.  
  26. if arg='B' then signal AB;if arg='G' then signal AG;if arg='V'|arg='H' then signal AV
  27. if arg='?' then do;tr helpT;exit;end;if v7=1&arg='C'&conf~=1 then tr 'f1'
  28. if arg='C'&conf=1 then do;se 'n1c3Loading z4c7LONGz0 c3who config...';tr '#0pfiles:who/Config}';exit;end;if getclip('IdleWhoB0')='' then se '#0pfiles:Who/Loader}'
  29. if arg='I'&conf=1 then do;se 'n1ceReLoading cbIdle cfPort c9Bannersc6...';call setclip('IdleWhoB0');tr '#0pfiles:who/Loader}cdDonec6!';exit;end
  30. if arg='Q' then quick=1;if arg='P' then do;a=getclip('IdleWhoB'myport);tr 'n1c6Port cb'myport'c9: ca'a'n1';exit;end
  31. if arg='E'&conf=1 then do;loadeditor 'pfiles:who/IdlePorts';tr 'n1ceEdit cb"caIdlePortscb" c6file...';calleditor 102;gu 1109865
  32.   st=result;if st=1 then do;se 'cfSaving cb"caIdlePortscb" c6file...';saveeditor 'pfiles:who/IdlePorts';tr 'cdDonec6!';end
  33.   else if st=0 then do;se 'c9Delete cb"caIdlePortscb" c6file? c7[caYesc7]c6: ca'
  34.   gc;a=result;if a='N' then tr 'No.';else do;se 'Yesc6!  c9Deletingc6...'
  35.   address command 'delete pfiles:who/IdlePorts';tr 'cdDonec6!';end;end;exit;end
  36. START:;tr "z6c4Portz0 z6c4User Handle         z0 z6c4Logon z0 z6c4Spdz0 z6c4From                    z0 z6c4Where            z0";call MGC
  37.   tr 'cc==== ==================== ====== === ======================== ================='
  38.   do ii=1 to totpit;i=subword(it.0,ii,1);if index(' 'it.0' ',i)=0 then iterate ii
  39.   if v6=1&ii=loS+1 then do;ii=hiSk-1;iterate ii;end;port=i;st=' ';gu 1101630+i;a=d2c(result);call MGC
  40.   mu=BitTST(a,1);if mu=1 then st='m';hi=BitTST(a,0);if hi=1&myport~=i then st='h'
  41.   getportid i;id=result;getwhere i;where=left(result,17);gu pd+(i*4);zy=c2d(import(offset(null(),result+30),2))
  42.   call MINUTES(zy);iT=zz;if where='(offline)' then iterate ii;if id=-1&(idle=1|v4=1) then iterate ii
  43.   off=1630+myport;gu pd+(i*4);hidden=result+off;hide=BitTST(import(offset(null(),hidden),1),0)
  44.   muff=BitTST(import(offset(null(),hidden),1),1);gu 1200032;a=result;if hide=1&conf~=1 then do;a=a+fake;id=-1;call MINUTES(a);iT=zz;end
  45.   call MGC;if hide=1&conf~=1&v5=1 then iterate ii;if id>-1 then do;loadscratch id;savescratch (-id);gs 1101333
  46.   con=BitTST(d2c(result,4),7);if con=1&myport~=i then st='+';if muff=1&con=0&st~='h' then st='M'
  47.   if hide=1&con=0 then st='H';if v1=1&zy>5 then where='c9Idle cb'iT;else where=where'cfcf'
  48.   gs 1;handle=result;gs 1201214;cps=result%10;gs 4;city=result;gs 56;country=result
  49.   gs 57;logon=right(result,6);gs 38;who=result;gs 11;date=substr(result,5,6);gs 1101133;gender=result
  50.   sex='z4cf  Male  z0';if result=0 then sex='z1cb Female z0';gs 18;time=result%10;gs 39;udir=result
  51.   his=exists("mail:users/"udir"/_History");call MGC;end
  52.   else do;handle=l903;where=l107;cps=0;city='';country='';logon='';a='';who=''
  53.   time=0;if v1=1&where=l107 then where='c9Idle cb'iT;if v2=1 then a=getclip('IdleWhoB'i)
  54.   if a='' then a=getclip('IdleWhoBD');call MGC;end;if id>-1|a='' then do
  55.   se 'cf'right(port,2)' cb'st' ce'handle'.26}cd'right(logon,6)
  56.   se ' cb'right(cps,3)' c6'left(city,21)left(country,3)' c9';tr where'ca';call MGC;end
  57.   else do;tr 'cf'right(port,2)' cb'st' 'a'.62}c9'where;call MGC;end
  58.   if id~=-1 then do;se 'z6c4 LC z0cf: ca'date' 'sex' cb'substr(' *',his+1,1)
  59.   tr 'z6c4 TT z0cf: c9'left(time,8)'@8ca'left(who,42)'cd';call MGC;end
  60.   if exists("mail:users/"udir"/_Glimpse")&id~=-1&quick=0 then do;sendfile "mail:users/"udir"/_Glimpse";call MGC;end
  61.   if ~exists("mail:users/"udir"/_Glimpse")&id~=-1&quick=0 then do;sendfile glimpse2;call MGC;end
  62.   if totpit>1&ii~=totpit&quick=0 then tr 'c6'copies('-',79)''
  63.   end ii;se 'cc'copies('=',79)'';call MGC;if help=3|quick=1 then signal MENU
  64.   if help=2 then do;se 'n1z6c4 LC z0cf=caLast Callcf, cb*cf=cbHistorycf, '
  65.   se 'z6c4 TT z0cf=c9Time Todaycf, cbmcf=cbMuffledcf, ';tr 'cbhcf=cbHiddencf, cb+cf=cbConf. Cont.';signal MENU;end
  66.   tr "n1   cbm cc= cdYou're Muffling this Port.         cbh cc= ceYou're Hiding from this Port.";call MGC
  67.   if conf=1 then tr "   cbM cc= caThey're trying to Muffle You.      cbH cc= caThey're trying to Hide from You."
  68.   tr "z6c4 LC z0cc = caUser's Last Call Date.          z6c4 TT z0cc = cdTime Used Today by this User."
  69.   tr "   cb* cc= cdThis User has a HISTORY File.      cb+ cc= ceUser has Conference Control.";call MGC
  70. MENU:;if quick=1 then exit;se 'n1c6Long cbWho c7[caBc7]caannerc6, c7[caGc7]calimpsec6, '
  71.   se 'c7[caVc7]caiew cfHistoryc6, or c7[cdQUITc7]c6: ca';gc;a=index('BGVHQ',result)
  72.   if a=0|a=5 then do;tr 'cdQuit';exit;end;if a=1 then do;tr 'Banner'
  73. AB:;gu 38;banner=result;b.0=banner;save=0
  74.   if v3=0&conf~=1 then do;tr 'n1c6You can c9NOT cfcreate ceMultiple cdWho Bannersc6! Use cfEP;14 c6instead!';signal MENU;end
  75.   if ~exists(banners) then do;address command "copy "banners2" "banners;end
  76.   call open(f1,banners,'r');do i=1 to 9;b.i=readln(f1);end i;call close(f1)
  77. E0:;tr 'f1n1c9r1 Your Short Who Banners r0n2ce Current Bannern1ca~~~~~~~~~~~~~~~~n1cdBanner cb0ca: @8ce'b.0
  78.   tr 'n1ce Banners On Filen1ca~~~~~~~~~~~~~~~~~';do i=1 to 9;tr 'cdBanner cb'i'ca: @8ce'b.i;end i
  79.   se 'n1c6Edit c7[ca0c7] c6thru c7[ca9c7]c6, c7[cdQc7]cduitc6, or c7[caPc7]caick c6current? c7[caPickc7]c6: ca'
  80.   gc;a=index('0123456789PQ',result);if result='###PANIC' then exit;else if a=0 then a=11
  81.   if a=12 then do;tr 'cdQuit';signal MENU;end;if a<11 then do;a=a-1;tr a
  82. E1:;addkeys (b.a);se 'n1c6Edit cdBanner cb'a'ca:cfi'128+v8*256' 42}';gu 70;ban=result
  83.   if index(ban,"") then do;tr "c9Control-Q characters are PROHIBITED in Banners!";b.a=ban;signal E1;end
  84.   if sysop=0|(sysop=1&v9=0) then do;ban2=ban;call STRIPSMCI;if ban2~=ban then tr "c9SysOp Only MCI's have been REMOVED! c7<ccKeyc7>g1";end
  85.   if mci1=0|mci2=0 then do;ban2=ban;call STRIPMCI2;if ban2~=ban then tr "c9Level 2 MCI's have been REMOVED! c7<ccKeyc7>g1";end
  86.   if mci1+mci2=0 then do;ban2=ban;call STRIPMCI;if ban2~=ban then tr "c9ALL MCI Occurances have been REMOVED! c7<ccKeyc7>g1";end
  87.   se 'n1c6Is cb"@8ce'ban'cb" c6Correct? c7[caYesc7]c6: ca';gc;c=result;if c='N' then do;tr 'No.';b.a=ban;signal E1;end
  88.   tr 'Yes!';b.a=ban;save=1;if a=0 then save=2;signal E2;end
  89.   if a=11 then do;se 'Pickn2c6Use which cdBanner c6as cfCurrentc6? c7[ce<ca1ce>c7-ca9c7]c6: ca'
  90.   gc;a=index('123456789',result);if a<1 then a=1;tr a;b=b.0;b.0=b.a;b.a='';do i=1 to 9;j=i+1
  91.   if b.i='' then do;b.i=b.j;b.j='';end;end i;b.9=b;save=2;end
  92. E2:;if save=2 then do;setobject b.0;putuser 38;end;if save>0 then do;call open(f1,banners,'w');do i=1 to 9
  93.   call writeln(f1,b.i);end i;call close(f1);save=0;end;signal E0;end;if a=2 then do;tr 'Glimpse'
  94. AG:;tr 'n1c6You''ll have cb3 c6lines to cfcreate c6and/or cdedit c6your cb"caGlimpsecb"c6 file...'
  95.   cleareditor;if exists(glimpse) then loadeditor glimpse;calleditor 3;gu 1109865;st=result;if exists(glimpse)&st=0 then do
  96.   se 'c9Delete c6your cb"caGlimpsecb"c6 file now? c7[caYesc7]c6: ca';gc;a=result
  97.   if a='N' then do;tr 'No.';signal MENU;end;else do;tr 'Yes!';address command 'delete 'glimpse
  98.   signal START;end;end;if st=1 then saveeditor glimpse;signal START;end;if a=3|a=4 then do;tr 'View History'
  99. AV:;se 'n1c7[caEc7]caditc6, c7[caVc7]caiew c6by cbPortc6, or c7[caSc7]capecific cfHistoriesc6? c7[cdQUITc7]c6: ca'
  100.   gc;a=index('EVPSHQ',result);if a=0|a=6 then do;tr 'cdQuit';signal MENU;end
  101.   if a=1 then do;tr 'Edit';tr 'n1c6You''ll have cb20 c6lines to cfcreate c6and/or cdedit c6your cb"caHistorycb"c6 file...'
  102.   if exists(history) then loadeditor history;else cleareditor;calleditor 20;gu 1109865;st=result;if exists(history)&st=0 then do
  103.   se 'c9Delete c6your cb"caHistorycb"c6 file now? c7[caYesc7]c6: ca';gc;a=result
  104.   if a='N' then do;tr 'No.';signal MENU;end;else do;tr 'Yes!';address command 'delete 'history;signal START;end;end
  105.   if st=1 then saveeditor history;signal START;end;if a=2|a=3 then do;tr 'View By Port'
  106. VPM:;se 'n1 caView c6the cfHistory File c6for the cdUser c6on which cbPortc6? c7'right('[ca'myport'c7]',10)'c6:cai192 2}'
  107.   gu 70;p=result;if p='' then p=myport;getportid p;id2=result;if id2=-1 then do;getwhere p;a=result
  108.   if a='(offline)' then do;tr 'n1c6That cbPort c6is c9NOT c6Loaded!';signal MENU;end
  109.   if a=l107 then do;tr 'n1c9No One c6is caUSING c6that cbPort c6now!';signal MENU;end;end
  110.   loadscratch id2;savescratch (-id2);gs 1;han=result;gs 39;udir=result
  111. VPA:;tr 'f1cer1'center('History File For "'han'" on Port 'p'...',78)'r0ca'
  112.   if ~exists("mail:users/"udir"/_History") then sendfile history2;else sendfile "mail:users/"udir"/_History"
  113.   se 'cc'copies('=',78)' n1c7[caVc7]caiew cbAnotherc6, c7[caRc7]caeView c6this cfHistoryc6, c7[caWc7]caho caListc6, or c7[cdQUITc7]c6: ca'
  114.   gc;a=index('VARHWLQ',result);if a=0|a=7 then do;tr 'cdQuit';exit;end;if a=1|a=2 then do;tr 'View Another';signal VPM;end
  115.   if a=3|a=4 then do;se 'ReView History';signal VPA;end;tr 'WHO Againn1';signal START;end;if a=4|a=5 then do;tr 'View Specific'
  116. VSM:;se 'n1c6Enter cfID#c6, ceHandlec6, or cbReal Name c6to caViewc6: c7[ca1c7]c6: cai144 25}'
  117.   gu 70;hid=result;if hid='' then hid=1;findaccount hid;st=result;if st=0 then do
  118.   tr 'n1c9This is an Invalid Account! c6Check your typing.';signal MENU;end;loadscratch st;savescratch (-st)
  119.   gs 1;han=result;gs 4;city=result;gs 39;udir=result
  120. VSA:;tr 'f1cer1'center('History File For "'han'" from 'city'...',78)'r0ca'
  121.   if ~exists("mail:users/"udir"/_History") then sendfile history2;else sendfile "mail:users/"udir"/_History"
  122.   se 'cc'copies('=',78)' n1c7[caVc7]caiew cbAnotherc6, c7[caRc7]caeView c6this cfHistoryc6, c7[caWc7]caho ceListc6, or c7[cdQUITc7]c6: ca'
  123.   gc;a=index('VARHWLQ',result);if a=0|a=7 then do;tr 'cdQuit';exit;end;if a=1|a=2 then do;tr 'View Another';signal VSM;end
  124.   if a=3|a=4 then do;se 'ReView History';signal VSA;end;tr 'WHO Againn1';signal START;end
  125. MGC:;mg;if result='NOCHAR' then return;else do;tr l1066;exit;end
  126. ARGS:;gu 1202244;total=result-1;args='';do i=0 to total+1;gu 1302307+(i*61);args=args||result' ';end i;return
  127. PARSER:;arg rng,min,max;it.='';c=0;it=translate(rng,'  ','.,');do a=1 to words(it);c=c+1;it.c=word(it,a)
  128.   if index(it.c,'-')>0 then do;parse var it.c x'-'y;if y='' then y=max;if x='' then x=min;if x>y then do;d=x;x=y;y=d;end
  129.   if x<min|y>max|~datatype(x,'W')|~datatype(y,'W') then do;c=c-1;iterate;end;do b=x to y;it.c=b;c=c+1;end;c=c-1;end
  130.   else if it.c<min|it.c>max|~datatype(it.c,'W') then do;c=c-1;iterate;end;end;totpit=c;do i=1 to c;it.0=it.0||it.i' ';end;return
  131. MINUTES:;arg m;t=right(m,1);m=m%10;hrs=m%60;mins=m-(hrs*60);if hrs=0 then zz=mins'.'t' caMinutes';else zz=hrs'.'mins%6' cdHours';return
  132. STRIPMCI:;do until z=0;z=index(ban,"");if z>0 then ban=delstr(ban,z,3);end;return ban
  133. STRIPMCI2:;do i=1 to length(l5);zz=""upper(substr(l5,i,1));do until z=0;z=index(upper(ban),zz);if z>0 then ban=delstr(ban,z,3);end;end i;return ban
  134. STRIPSMCI:;do i=1 to length(l4);zz=""upper(substr(l4,i,1));do until z=0;z=index(upper(ban),zz);if z>0 then ban=delstr(ban,z,3);end;end i;return ban
  135. CONFIG:;call open(f1,'pfiles:who/config.data','r');a=readln(f1);call close(f1);parse var a l107''l903''l1066''fake''l5''l4''j;return
  136. SYNTAX:;ERROR:;IOERR:;e1=' Error: 'rc' ('errortext(rc)')';e2='  Line: 'left(sigl,4)'File:';gu 1311992;a=result
  137.   gu 1311960;b=result;c='"'a||b'"';e2=e2' 'c;tr e1;tr e2;logentry e1;logentry e2;e=sourceline(sigl)
  138.   do while e~='';e3='Source: 'left(e,37);tr e3;logentry e3;e=substr(e,38);end;bufferflush
  139. /** Last Edited: 15-Oct-95 ************************************************\
  140. \****************************************** Frontiers BBS (716)/823-9892 **/
  141.